home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 15 / Amiga Plus Leser CD 15.iso / Tools / Development / yacas_alg / yacas_morphos / share / yacas / solve.rep / code.ys < prev   
Encoding:
Text File  |  2002-03-13  |  5.3 KB  |  227 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6. SolveNrUses(_fie,_var) <--  Count(VarListAll(fie),var);
  7.  
  8.  
  9.  
  10.  
  11. 10 # Solve(eq_IsList,var_IsList) <--
  12. [
  13.  If(Verbose, Echo({"Entering Solve"}));
  14.  
  15.   Local(result,i,j,nrvar,nreq,sub);
  16.   nrvar:=Length(var);
  17.   nreq:=Length(eq);
  18.   result:={FlatCopy(var)};
  19.   eq:=Simplify(eq);
  20.  
  21.   /* Loop over each variable, solving for it */
  22.  
  23. /* Echo({eq});  */
  24.  
  25.   For(i:=1,i<=nrvar,i++)
  26.   [
  27.     For(j:=1,j<=nreq,j++)
  28.     [
  29.  
  30.       If(SolveNrUses(eq[j],var[i]) = 1,
  31.          [
  32.            sub:=Solve(eq[j],var[i]);
  33. /*
  34. DestructiveDelete(eq,j);
  35. nreq--;
  36. */
  37.  If(Verbose, Echo({"From ",eq[j]," it follows that ",var[i]," = ",sub})); 
  38.  
  39. /*           result:=Eliminate(var[i],sub,result);*/
  40.  
  41.        result:=Simplify(Subst(var[i],sub)result);
  42. /*           eq:=Eliminate(var[i],sub,eq); */
  43. /*           eq[j] := (0 == 0);  */
  44.            Local(k);
  45.            For(k:=1,k<=Length(eq),k++)
  46.            [
  47.              Local(original);
  48.              original:=eq[k];
  49.              eq[k]:=Simplify(Subst(var[i],sub)eq[k]);
  50.              If(Verbose, Echo({"   ",original," simplifies to ",eq[k]}));
  51.            ];
  52. /*           eq:=Simplify(Subst(var[i],sub)eq); */
  53. /* Echo({eq});  */
  54.            j:=nreq+1;
  55.          ]);
  56.     ];
  57.   ];
  58.  
  59.  
  60.   Local(zeroeq,tested);
  61.   tested:={};
  62.   zeroeq:=FillList(0==0,nreq);
  63.  
  64.   ApplyPure("MacroLocal",var);
  65.  
  66.   ForEach(item,result)
  67.   [
  68.     Apply(":=",{var,item});
  69.  
  70.     If(Simplify(Eval(eq)) = zeroeq,
  71.     [
  72.       DestructiveAppend(tested,item);
  73.     ]);
  74.   ];
  75.  
  76. /* Echo({"tested is ",tested});  */
  77.  
  78.  If(Verbose, Echo({"Leaving Solve"}));
  79.  
  80.   tested;
  81. ];
  82.  
  83.  
  84. 90 # Solve((left_IsList) == right_IsList,_var) <--
  85.       Solve(Map("==",{left,right}),var);
  86.  
  87.  
  88. 100 # Solve(_left == _right,_var) <--
  89.      SuchThat(left - right , 0 , var);
  90.  
  91. /* HoldArg("Solve",arg1); */
  92. /* HoldArg("Solve",arg2); */
  93.  
  94.  
  95. 10 # ContainsExpression(_body,_body) <-- True;
  96. 15 # ContainsExpression(body_IsAtom,_expr) <-- False;
  97. 20 # ContainsExpression(body_IsFunction,_expr) <--
  98. [
  99.   Local(result,args);
  100.   result:=False;
  101.   args:=Tail(Listify(body));
  102.   While(args != {})
  103.   [
  104.     result:=ContainsExpression(Head(args),expr);
  105.     args:=Tail(args);
  106.     if (result = True) (args:={});
  107.   ];
  108.   result;
  109. ];
  110.  
  111.  
  112. SuchThat(_function,_var) <-- SuchThat(function,0,var);
  113.  
  114. 10 # SuchThat(_left,_right,_var)_(left = var) <-- right;
  115.  
  116. /*This interferes a little with the multi-equation solver...
  117. 15 # SuchThat(_left,_right,_var)_CanBeUni(left-right,var) <--
  118.      PSolve(MakeUni(left-right,var));
  119. */
  120.  
  121. 20 # SuchThat(left_IsAtom,_right,_var) <-- var;
  122.  
  123. 30 # SuchThat((_x) + (_y),_right,_var)_ContainsExpression(x,var) <--
  124.     SuchThat(x , right-y , var);
  125. 30 # SuchThat((_y) + (_x),_right,_var)_ContainsExpression(x,var) <--
  126.     SuchThat(x , right-y , var);
  127.  
  128. 30 # SuchThat(Complex(_r,_i),_right,_var)_ContainsExpression(r,var) <--
  129.     SuchThat(r , right-I*i , var);
  130. 30 # SuchThat(Complex(_r,_i),_right,_var)_ContainsExpression(i,var) <--
  131.     SuchThat(i , right+I*r , var);
  132.  
  133. 30 # SuchThat(_x * _y,_right,_var)_ContainsExpression(x,var) <--
  134.     SuchThat(x , right/y , var);
  135. 30 # SuchThat(_y * _x,_right,_var)_ContainsExpression(x,var) <--
  136.     SuchThat(x , right/y , var);
  137.  
  138. 30 # SuchThat(_x ^ _y,_right,_var)_ContainsExpression(x,var) <--
  139.     SuchThat(x , right^(1/y) , var);
  140. 30 # SuchThat(_x ^ _y,_right,_var)_ContainsExpression(y,var) <--
  141.     SuchThat(y , Ln(right)/Ln(x) , var);
  142.  
  143. 30 # SuchThat(Sin(_x),_right,_var) <--
  144.     SuchThat(x , ArcSin(right) , var);
  145. 30 # SuchThat(ArcSin(_x),_right,_var) <--
  146.     SuchThat(x , Sin(right) , var);
  147.  
  148. 30 # SuchThat(Cos(_x),_right,_var) <--
  149.     SuchThat(x , ArcCos(right) , var);
  150. 30 # SuchThat(ArcCos(_x),_right,_var) <--
  151.     SuchThat(x , Cos(right) , var);
  152.  
  153. 30 # SuchThat(Tan(_x),_right,_var) <--
  154.     SuchThat(x , ArcTan(right) , var);
  155. 30 # SuchThat(ArcTan(_x),_right,_var) <--
  156.     SuchThat(x , Tan(right) , var);
  157.  
  158. 30 # SuchThat(Exp(_x),_right,_var) <--
  159.     SuchThat(x , Ln(right) , var);
  160. 30 # SuchThat(Ln(_x),_right,_var) <--
  161.     SuchThat(x , Exp(right) , var);
  162.  
  163. 30 # SuchThat(_x / _y,_right,_var)_ContainsExpression(x,var) <--
  164.     SuchThat(x , right*y , var);
  165. 30 # SuchThat(_y / _x,_right,_var)_ContainsExpression(x,var) <--
  166.     SuchThat(x , y/right , var);
  167.  
  168. 30 # SuchThat(- (_x),_right,_var) <--
  169.     SuchThat(x , -right , var);
  170.  
  171. 30 # SuchThat((_x) - (_y),_right,_var)_ContainsExpression(x,var) <--
  172.     SuchThat(x , right+y , var);
  173. 30 # SuchThat((_y) - (_x),_right,_var)_ContainsExpression(x,var) <--
  174.     SuchThat(x , y-right , var);
  175.  
  176. 30 # SuchThat(Sqrt(_x),_right,_var) <--
  177.     SuchThat(x , right^2 , var);
  178.  
  179.  
  180. Function("SolveMatrix",{matrix,vector})
  181. [
  182.   Local(perms,indices,inv,det,n);
  183.   n:=Length(matrix);
  184.   indices:=Table(i,i,1,n,1);
  185.   perms:=Permutations(indices);
  186.   inv:=ZeroVector(n);
  187.   det:=0;
  188.   ForEach(item,perms)
  189.   [
  190.     Local(i,lc);
  191.     lc := LeviCivita(item);
  192.     det:=det+Factorize(i,1,n,matrix[i][item[i] ])* lc;
  193.     For(i:=1,i<=n,i++)
  194.         [
  195.          inv[i] := inv[i]+
  196.            Factorize(j,1,n,
  197.            If(item[j] =i,vector[j ],matrix[j][item[j] ]))*lc;
  198.         ];
  199.   ];
  200.   Check(det != 0, "Zero determinant");
  201.   (1/det)*inv;
  202. ];
  203.  
  204.  
  205.  
  206. Function("Newton",{function,variable,initial,accuracy})
  207. /*block*/
  208. [
  209.   Local(result,adjust,delta);
  210.   MacroLocal(variable);
  211.   function:=N(function);
  212.   adjust:= -function/Apply("D",{variable,function});
  213.   delta:=10000;
  214.   result:=initial;
  215.   While (N(delta*Conjugate(delta)>accuracy*accuracy))
  216.   [
  217.     MacroSet(variable,result);
  218.     delta:=N(adjust);
  219.     result:=result+delta;
  220.   ];
  221.   result;
  222. ];
  223. HoldArg("Newton",function);
  224. HoldArg("Newton",variable);
  225.  
  226.  
  227.